home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / generic / tkCmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  43.1 KB  |  1,575 lines
  1. /* 
  2.  * tkCmds.c --
  3.  *
  4.  *    This file contains a collection of Tk-related Tcl commands
  5.  *    that didn't fit in any particular file of the toolkit.
  6.  *
  7.  * Copyright (c) 1990-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tkCmds.c 1.110 96/04/03 15:54:47
  14.  */
  15.  
  16. #include "tkPort.h"
  17. #include "tkInt.h"
  18. #include <errno.h>
  19.  
  20. /*
  21.  * Forward declarations for procedures defined later in this file:
  22.  */
  23.  
  24. static Tk_Window    GetDisplayOf _ANSI_ARGS_((Tcl_Interp *interp,
  25.                 Tk_Window tkwin, char **argv));
  26. static TkWindow *    GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
  27. static char *        WaitVariableProc _ANSI_ARGS_((ClientData clientData,
  28.                 Tcl_Interp *interp, char *name1, char *name2,
  29.                 int flags));
  30. static void        WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
  31.                 XEvent *eventPtr));
  32. static void        WaitWindowProc _ANSI_ARGS_((ClientData clientData,
  33.                 XEvent *eventPtr));
  34.  
  35. /*
  36.  *----------------------------------------------------------------------
  37.  *
  38.  * Tk_BellCmd --
  39.  *
  40.  *    This procedure is invoked to process the "bell" Tcl command.
  41.  *    See the user documentation for details on what it does.
  42.  *
  43.  * Results:
  44.  *    A standard Tcl result.
  45.  *
  46.  * Side effects:
  47.  *    See the user documentation.
  48.  *
  49.  *----------------------------------------------------------------------
  50.  */
  51.  
  52. int
  53. Tk_BellCmd(clientData, interp, argc, argv)
  54.     ClientData clientData;    /* Main window associated with interpreter. */
  55.     Tcl_Interp *interp;        /* Current interpreter. */
  56.     int argc;            /* Number of arguments. */
  57.     char **argv;        /* Argument strings. */
  58. {
  59.     Tk_Window tkwin = (Tk_Window) clientData;
  60.     size_t length;
  61.  
  62.     if ((argc != 1) && (argc != 3)) {
  63.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  64.         " ?-displayof window?\"", (char *) NULL);
  65.     return TCL_ERROR;
  66.     }
  67.  
  68.     if (argc == 3) {
  69.     length = strlen(argv[1]);
  70.     if ((length < 2) || (strncmp(argv[1], "-displayof", length) != 0)) {
  71.         Tcl_AppendResult(interp, "bad option \"", argv[1],
  72.             "\": must be -displayof", (char *) NULL);
  73.         return TCL_ERROR;
  74.     }
  75.     tkwin = Tk_NameToWindow(interp, argv[2], tkwin);
  76.     if (tkwin == NULL) {
  77.         return TCL_ERROR;
  78.     }
  79.     }
  80.     XBell(Tk_Display(tkwin), 0);
  81.     XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
  82.     XFlush(Tk_Display(tkwin));
  83.     return TCL_OK;
  84. }
  85.  
  86. /*
  87.  *----------------------------------------------------------------------
  88.  *
  89.  * Tk_BindCmd --
  90.  *
  91.  *    This procedure is invoked to process the "bind" Tcl command.
  92.  *    See the user documentation for details on what it does.
  93.  *
  94.  * Results:
  95.  *    A standard Tcl result.
  96.  *
  97.  * Side effects:
  98.  *    See the user documentation.
  99.  *
  100.  *----------------------------------------------------------------------
  101.  */
  102.  
  103. int
  104. Tk_BindCmd(clientData, interp, argc, argv)
  105.     ClientData clientData;    /* Main window associated with interpreter. */
  106.     Tcl_Interp *interp;        /* Current interpreter. */
  107.     int argc;            /* Number of arguments. */
  108.     char **argv;        /* Argument strings. */
  109. {
  110.     Tk_Window tkwin = (Tk_Window) clientData;
  111.     TkWindow *winPtr;
  112.     ClientData object;
  113.  
  114.     if ((argc < 2) || (argc > 4)) {
  115.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  116.         " window ?pattern? ?command?\"", (char *) NULL);
  117.     return TCL_ERROR;
  118.     }
  119.     if (argv[1][0] == '.') {
  120.     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
  121.     if (winPtr == NULL) {
  122.         return TCL_ERROR;
  123.     }
  124.     object = (ClientData) winPtr->pathName;
  125.     } else {
  126.     winPtr = (TkWindow *) clientData;
  127.     object = (ClientData) Tk_GetUid(argv[1]);
  128.     }
  129.  
  130.     if (argc == 4) {
  131.     int append = 0;
  132.     unsigned long mask;
  133.  
  134.     if (argv[3][0] == 0) {
  135. #ifdef STk_CODE
  136.       /* delete the old binding from the callback table */
  137.       STk_add_callback(argv[1], argv[2], "", STk_get_NIL_value());
  138. #endif
  139.         return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
  140.             object, argv[2]);
  141.     }
  142. #ifdef STk_CODE
  143.     mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
  144.         object, argv[2], argv[3], argv[1], "");
  145. #else
  146.     if (argv[3][0] == '+') {
  147.         argv[3]++;
  148.         append = 1;
  149.     }
  150.     mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
  151.         object, argv[2], argv[3], append);
  152. #endif
  153.     if (mask == 0) {
  154.         return TCL_ERROR;
  155.     }
  156.     } else if (argc == 3) {
  157.     char *command;
  158.  
  159.     command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
  160.         object, argv[2]);
  161.     if (command == NULL) {
  162.         Tcl_ResetResult(interp);
  163.         return TCL_OK;
  164.     }
  165.     interp->result = command;
  166.     } else {
  167.     Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
  168.     }
  169.     return TCL_OK;
  170. }
  171.  
  172. /*
  173.  *----------------------------------------------------------------------
  174.  *
  175.  * TkBindEventProc --
  176.  *
  177.  *    This procedure is invoked by Tk_HandleEvent for each event;  it
  178.  *    causes any appropriate bindings for that event to be invoked.
  179.  *
  180.  * Results:
  181.  *    None.
  182.  *
  183.  * Side effects:
  184.  *    Depends on what bindings have been established with the "bind"
  185.  *    command.
  186.  *
  187.  *----------------------------------------------------------------------
  188.  */
  189.  
  190. void
  191. TkBindEventProc(winPtr, eventPtr)
  192.     TkWindow *winPtr;            /* Pointer to info about window. */
  193.     XEvent *eventPtr;            /* Information about event. */
  194. {
  195. #define MAX_OBJS 20
  196.     ClientData objects[MAX_OBJS], *objPtr;
  197.     static Tk_Uid allUid = NULL;
  198.     TkWindow *topLevPtr;
  199.     int i, count;
  200.     char *p;
  201.     Tcl_HashEntry *hPtr;
  202.  
  203.     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
  204.     return;
  205.     }
  206.  
  207.     objPtr = objects;
  208.     if (winPtr->numTags != 0) {
  209.     /*
  210.      * Make a copy of the tags for the window, replacing window names
  211.      * with pointers to the pathName from the appropriate window.
  212.      */
  213.  
  214.     if (winPtr->numTags > MAX_OBJS) {
  215.         objPtr = (ClientData *) ckalloc((unsigned)
  216.             (winPtr->numTags * sizeof(ClientData)));
  217.     }
  218.     for (i = 0; i < winPtr->numTags; i++) {
  219.         p = (char *) winPtr->tagPtr[i];
  220.         if (*p == '.') {
  221.         hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
  222.         if (hPtr != NULL) {
  223.             p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
  224.         } else {
  225.             p = NULL;
  226.         }
  227.         }
  228.         objPtr[i] = (ClientData) p;
  229.     }
  230.     count = winPtr->numTags;
  231.     } else {
  232.     objPtr[0] = (ClientData) winPtr->pathName;
  233.     objPtr[1] = (ClientData) winPtr->classUid;
  234.     for (topLevPtr = winPtr;
  235.         (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_LEVEL);
  236.         topLevPtr = topLevPtr->parentPtr) {
  237.         /* Empty loop body. */
  238.     }
  239.     if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
  240.         count = 4;
  241.         objPtr[2] = (ClientData) topLevPtr->pathName;
  242.     } else {
  243.         count = 3;
  244.     }
  245.     if (allUid == NULL) {
  246.         allUid = Tk_GetUid("all");
  247.     }
  248.     objPtr[count-1] = (ClientData) allUid;
  249.     }
  250.     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
  251.         count, objPtr);
  252.     if (objPtr != objects) {
  253.     ckfree((char *) objPtr);
  254.     }
  255. }
  256.  
  257. /*
  258.  *----------------------------------------------------------------------
  259.  *
  260.  * Tk_BindtagsCmd --
  261.  *
  262.  *    This procedure is invoked to process the "bindtags" Tcl command.
  263.  *    See the user documentation for details on what it does.
  264.  *
  265.  * Results:
  266.  *    A standard Tcl result.
  267.  *
  268.  * Side effects:
  269.  *    See the user documentation.
  270.  *
  271.  *----------------------------------------------------------------------
  272.  */
  273.  
  274. int
  275. Tk_BindtagsCmd(clientData, interp, argc, argv)
  276.     ClientData clientData;    /* Main window associated with interpreter. */
  277.     Tcl_Interp *interp;        /* Current interpreter. */
  278.     int argc;            /* Number of arguments. */
  279.     char **argv;        /* Argument strings. */
  280. {
  281.     Tk_Window tkwin = (Tk_Window) clientData;
  282.     TkWindow *winPtr, *winPtr2;
  283.     int i, tagArgc;
  284.     char *p, **tagArgv;
  285.  
  286.     if ((argc < 2) || (argc > 3)) {
  287.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  288.         " window ?tags?\"", (char *) NULL);
  289.     return TCL_ERROR;
  290.     }
  291.     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
  292.     if (winPtr == NULL) {
  293.     return TCL_ERROR;
  294.     }
  295.     if (argc == 2) {
  296. #ifdef STk_CODE
  297.         Tcl_AppendResult(interp, "(", NULL);
  298. #endif
  299.     if (winPtr->numTags == 0) {
  300. #ifdef STk_CODE
  301.         Tcl_AppendResult(interp, " #.", winPtr->pathName, NULL);
  302.         Tcl_AppendResult(interp, " \"", winPtr->classUid, "\"", NULL);
  303. #else
  304.         Tcl_AppendElement(interp, winPtr->pathName);
  305.         Tcl_AppendElement(interp, winPtr->classUid);
  306. #endif
  307.         for (winPtr2 = winPtr;
  308.             (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL);
  309.             winPtr2 = winPtr2->parentPtr) {
  310.         /* Empty loop body. */
  311.         }
  312.         if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
  313. #ifdef STk_CODE
  314.         Tcl_AppendResult(interp, " #.", winPtr2->pathName, NULL);
  315. #else
  316.         Tcl_AppendElement(interp, winPtr2->pathName);
  317. #endif
  318.         }
  319. #ifdef STk_CODE
  320.         Tcl_AppendElement(interp, "\"all\"");
  321. #else
  322.         Tcl_AppendElement(interp, "all");
  323. #endif
  324.     } else {
  325.         for (i = 0; i < winPtr->numTags; i++) {
  326. #ifdef STk_CODE
  327.             char *s = winPtr->tagPtr[i];
  328.         
  329.         if (*s == '.')
  330.           Tcl_AppendResult(interp, " #.", s, NULL);
  331.         else
  332.           Tcl_AppendResult(interp, " \"", s, "\"", NULL);
  333. #else
  334.         Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);
  335. #endif
  336.         }
  337.     }
  338. #ifdef STk_CODE
  339.         Tcl_AppendResult(interp, ")", NULL);
  340. #endif
  341.     return TCL_OK;
  342.     }
  343.     if (winPtr->tagPtr != NULL) {
  344.     TkFreeBindingTags(winPtr);
  345.     }
  346.     if (argv[2][0] == 0) {
  347.     return TCL_OK;
  348.     }
  349.     if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {
  350.     return TCL_ERROR;
  351.     }
  352.     winPtr->numTags = tagArgc;
  353.     winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
  354.         (tagArgc * sizeof(ClientData)));
  355.     for (i = 0; i < tagArgc; i++) {
  356.     p = tagArgv[i];
  357.     if (p[0] == '.') {
  358.         char *copy;
  359.  
  360.         /*
  361.          * Handle names starting with "." specially: store a malloc'ed
  362.          * string, rather than a Uid;  at event time we'll look up the
  363.          * name in the window table and use the corresponding window,
  364.          * if there is one.
  365.          */
  366.  
  367.         copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
  368.         strcpy(copy, p);
  369.         winPtr->tagPtr[i] = (ClientData) copy;
  370.     } else {
  371.         winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
  372.     }
  373.     }
  374.     ckfree((char *) tagArgv);
  375.     return TCL_OK;
  376. }
  377.  
  378. /*
  379.  *----------------------------------------------------------------------
  380.  *
  381.  * TkFreeBindingTags --
  382.  *
  383.  *    This procedure is called to free all of the binding tags
  384.  *    associated with a window;  typically it is only invoked where
  385.  *    there are window-specific tags.
  386.  *
  387.  * Results:
  388.  *    None.
  389.  *
  390.  * Side effects:
  391.  *    Any binding tags for winPtr are freed.
  392.  *
  393.  *----------------------------------------------------------------------
  394.  */
  395.  
  396. void
  397. TkFreeBindingTags(winPtr)
  398.     TkWindow *winPtr;        /* Window whose tags are to be released. */
  399. {
  400.     int i;
  401.     char *p;
  402.  
  403.     for (i = 0; i < winPtr->numTags; i++) {
  404.     p = (char *) (winPtr->tagPtr[i]);
  405.     if (*p == '.') {
  406.         /*
  407.          * Names starting with "." are malloced rather than Uids, so
  408.          * they have to be freed.
  409.          */
  410.     
  411.         ckfree(p);
  412.     }
  413.     }
  414.     ckfree((char *) winPtr->tagPtr);
  415.     winPtr->numTags = 0;
  416.     winPtr->tagPtr = NULL;
  417. }
  418.  
  419. /*
  420.  *----------------------------------------------------------------------
  421.  *
  422.  * Tk_DestroyCmd --
  423.  *
  424.  *    This procedure is invoked to process the "destroy" Tcl command.
  425.  *    See the user documentation for details on what it does.
  426.  *
  427.  * Results:
  428.  *    A standard Tcl result.
  429.  *
  430.  * Side effects:
  431.  *    See the user documentation.
  432.  *
  433.  *----------------------------------------------------------------------
  434.  */
  435.  
  436. int
  437. Tk_DestroyCmd(clientData, interp, argc, argv)
  438.     ClientData clientData;        /* Main window associated with
  439.                  * interpreter. */
  440.     Tcl_Interp *interp;        /* Current interpreter. */
  441.     int argc;            /* Number of arguments. */
  442.     char **argv;        /* Argument strings. */
  443. {
  444.     Tk_Window window;
  445.     Tk_Window tkwin = (Tk_Window) clientData;
  446.     int i;
  447.  
  448.     for (i = 1; i < argc; i++) {
  449.     window = Tk_NameToWindow(interp, argv[i], tkwin);
  450.     if (window == NULL) {
  451.         return TCL_ERROR;
  452.     }
  453.     Tk_DestroyWindow(window);
  454.     }
  455.     return TCL_OK;
  456. }
  457.  
  458. /*
  459.  *----------------------------------------------------------------------
  460.  *
  461.  * Tk_LowerCmd --
  462.  *
  463.  *    This procedure is invoked to process the "lower" Tcl command.
  464.  *    See the user documentation for details on what it does.
  465.  *
  466.  * Results:
  467.  *    A standard Tcl result.
  468.  *
  469.  * Side effects:
  470.  *    See the user documentation.
  471.  *
  472.  *----------------------------------------------------------------------
  473.  */
  474.  
  475.     /* ARGSUSED */
  476. int
  477. Tk_LowerCmd(clientData, interp, argc, argv)
  478.     ClientData clientData;    /* Main window associated with
  479.                  * interpreter. */
  480.     Tcl_Interp *interp;        /* Current interpreter. */
  481.     int argc;            /* Number of arguments. */
  482.     char **argv;        /* Argument strings. */
  483. {
  484.     Tk_Window main = (Tk_Window) clientData;
  485.     Tk_Window tkwin, other;
  486.  
  487.     if ((argc != 2) && (argc != 3)) {
  488.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  489.         argv[0], " window ?belowThis?\"", (char *) NULL);
  490.     return TCL_ERROR;
  491.     }
  492.  
  493.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  494.     if (tkwin == NULL) {
  495.     return TCL_ERROR;
  496.     }
  497.     if (argc == 2) {
  498.     other = NULL;
  499.     } else {
  500.     other = Tk_NameToWindow(interp, argv[2], main);
  501.     if (other == NULL) {
  502.         return TCL_ERROR;
  503.     }
  504.     }
  505.     if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
  506.     Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
  507.         argv[2], "\"", (char *) NULL);
  508.     return TCL_ERROR;
  509.     }
  510.     return TCL_OK;
  511. }
  512.  
  513. /*
  514.  *----------------------------------------------------------------------
  515.  *
  516.  * Tk_RaiseCmd --
  517.  *
  518.  *    This procedure is invoked to process the "raise" Tcl command.
  519.  *    See the user documentation for details on what it does.
  520.  *
  521.  * Results:
  522.  *    A standard Tcl result.
  523.  *
  524.  * Side effects:
  525.  *    See the user documentation.
  526.  *
  527.  *----------------------------------------------------------------------
  528.  */
  529.  
  530.     /* ARGSUSED */
  531. int
  532. Tk_RaiseCmd(clientData, interp, argc, argv)
  533.     ClientData clientData;    /* Main window associated with
  534.                  * interpreter. */
  535.     Tcl_Interp *interp;        /* Current interpreter. */
  536.     int argc;            /* Number of arguments. */
  537.     char **argv;        /* Argument strings. */
  538. {
  539.     Tk_Window main = (Tk_Window) clientData;
  540.     Tk_Window tkwin, other;
  541.  
  542.     if ((argc != 2) && (argc != 3)) {
  543.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  544.         argv[0], " window ?aboveThis?\"", (char *) NULL);
  545.     return TCL_ERROR;
  546.     }
  547.  
  548.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  549.     if (tkwin == NULL) {
  550.     return TCL_ERROR;
  551.     }
  552.     if (argc == 2) {
  553.     other = NULL;
  554.     } else {
  555.     other = Tk_NameToWindow(interp, argv[2], main);
  556.     if (other == NULL) {
  557.         return TCL_ERROR;
  558.     }
  559.     }
  560.     if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
  561.     Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
  562.         argv[2], "\"", (char *) NULL);
  563.     return TCL_ERROR;
  564.     }
  565.     return TCL_OK;
  566. }
  567.  
  568. /*
  569.  *----------------------------------------------------------------------
  570.  *
  571.  * Tk_TkCmd --
  572.  *
  573.  *    This procedure is invoked to process the "tk" Tcl command.
  574.  *    See the user documentation for details on what it does.
  575.  *
  576.  * Results:
  577.  *    A standard Tcl result.
  578.  *
  579.  * Side effects:
  580.  *    See the user documentation.
  581.  *
  582.  *----------------------------------------------------------------------
  583.  */
  584.  
  585.     /* ARGSUSED */
  586. int
  587. Tk_TkCmd(clientData, interp, argc, argv)
  588.     ClientData clientData;    /* Main window associated with
  589.                  * interpreter. */
  590.     Tcl_Interp *interp;        /* Current interpreter. */
  591.     int argc;            /* Number of arguments. */
  592.     char **argv;        /* Argument strings. */
  593. {
  594.     char c;
  595.     size_t length;
  596.     Tk_Window tkwin = (Tk_Window) clientData;
  597.     TkWindow *winPtr;
  598.  
  599.     if (argc < 2) {
  600.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  601.         argv[0], " option ?arg?\"", (char *) NULL);
  602.     return TCL_ERROR;
  603.     }
  604.     c = argv[1][0];
  605.     length = strlen(argv[1]);
  606.     if ((c == 'a') && (strncmp(argv[1], "appname", length) == 0)) {
  607.     winPtr = ((TkWindow *) tkwin)->mainPtr->winPtr;
  608.     if (argc > 3) {
  609.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  610.             " appname ?newName?\"", (char *) NULL);
  611.         return TCL_ERROR;
  612.     }
  613.     if (argc == 3) {
  614.         winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, argv[2]));
  615.     }
  616. #ifdef STk_CODE
  617.     STk_stringify_result(interp, winPtr->nameUid);
  618. #else
  619.     interp->result = winPtr->nameUid;
  620. #endif
  621.     } else {
  622.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  623.         "\": must be appname", (char *) NULL);
  624.     return TCL_ERROR;
  625.     }
  626.     return TCL_OK;
  627. }
  628.  
  629. /*
  630.  *----------------------------------------------------------------------
  631.  *
  632.  * Tk_TkwaitCmd --
  633.  *
  634.  *    This procedure is invoked to process the "tkwait" Tcl command.
  635.  *    See the user documentation for details on what it does.
  636.  *
  637.  * Results:
  638.  *    A standard Tcl result.
  639.  *
  640.  * Side effects:
  641.  *    See the user documentation.
  642.  *
  643.  *----------------------------------------------------------------------
  644.  */
  645.  
  646.     /* ARGSUSED */
  647. int
  648. Tk_TkwaitCmd(clientData, interp, argc, argv)
  649.     ClientData clientData;    /* Main window associated with
  650.                  * interpreter. */
  651.     Tcl_Interp *interp;        /* Current interpreter. */
  652.     int argc;            /* Number of arguments. */
  653.     char **argv;        /* Argument strings. */
  654. {
  655.     Tk_Window tkwin = (Tk_Window) clientData;
  656.     int c, done;
  657.     size_t length;
  658.  
  659.     if (argc != 3) {
  660.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  661.         argv[0], " variable|visibility|window name\"", (char *) NULL);
  662.     return TCL_ERROR;
  663.     }
  664.     c = argv[1][0];
  665.     length = strlen(argv[1]);
  666.     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
  667.         && (length >= 2)) {
  668.     if (Tcl_TraceVar(interp, argv[2],
  669.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  670.         WaitVariableProc, (ClientData) &done) != TCL_OK) {
  671.         return TCL_ERROR;
  672.     }
  673.     done = 0;
  674.     while (!done) {
  675.         Tcl_DoOneEvent(0);
  676.     }
  677.     Tcl_UntraceVar(interp, argv[2],
  678.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  679.         WaitVariableProc, (ClientData) &done);
  680.     } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
  681.         && (length >= 2)) {
  682.     Tk_Window window;
  683.  
  684.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  685.     if (window == NULL) {
  686.         return TCL_ERROR;
  687.     }
  688.     Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
  689.         WaitVisibilityProc, (ClientData) &done);
  690.     done = 0;
  691.     while (!done) {
  692.         Tcl_DoOneEvent(0);
  693.     }
  694.     if (done != 1) {
  695.         /*
  696.          * Note that we do not delete the event handler because it
  697.          * was deleted automatically when the window was destroyed.
  698.          */
  699.  
  700.         Tcl_ResetResult(interp);
  701.         Tcl_AppendResult(interp, "window \"", argv[2],
  702.             "\" was deleted before its visibility changed",
  703.             (char *) NULL);
  704.         return TCL_ERROR;
  705.     }
  706.     Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
  707.         WaitVisibilityProc, (ClientData) &done);
  708.     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
  709.     Tk_Window window;
  710.  
  711.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  712.     if (window == NULL) {
  713.         return TCL_ERROR;
  714.     }
  715.     Tk_CreateEventHandler(window, StructureNotifyMask,
  716.         WaitWindowProc, (ClientData) &done);
  717.     done = 0;
  718.     while (!done) {
  719.         Tcl_DoOneEvent(0);
  720.     }
  721.     /*
  722.      * Note:  there's no need to delete the event handler.  It was
  723.      * deleted automatically when the window was destroyed.
  724.      */
  725.     } else {
  726.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  727.         "\": must be variable, visibility, or window", (char *) NULL);
  728.     return TCL_ERROR;
  729.     }
  730.  
  731.     /*
  732.      * Clear out the interpreter's result, since it may have been set
  733.      * by event handlers.
  734.      */
  735.  
  736.     Tcl_ResetResult(interp);
  737.     return TCL_OK;
  738. }
  739.  
  740.     /* ARGSUSED */
  741. static char *
  742. WaitVariableProc(clientData, interp, name1, name2, flags)
  743.     ClientData clientData;    /* Pointer to integer to set to 1. */
  744.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  745.     char *name1;        /* Name of variable. */
  746.     char *name2;        /* Second part of variable name. */
  747.     int flags;            /* Information about what happened. */
  748. {
  749.     int *donePtr = (int *) clientData;
  750.  
  751.     *donePtr = 1;
  752.     return (char *) NULL;
  753. }
  754.  
  755.     /*ARGSUSED*/
  756. static void
  757. WaitVisibilityProc(clientData, eventPtr)
  758.     ClientData clientData;    /* Pointer to integer to set to 1. */
  759.     XEvent *eventPtr;        /* Information about event (not used). */
  760. {
  761.     int *donePtr = (int *) clientData;
  762.  
  763.     if (eventPtr->type == VisibilityNotify) {
  764.     *donePtr = 1;
  765.     }
  766.     if (eventPtr->type == DestroyNotify) {
  767.     *donePtr = 2;
  768.     }
  769. }
  770.  
  771. static void
  772. WaitWindowProc(clientData, eventPtr)
  773.     ClientData clientData;    /* Pointer to integer to set to 1. */
  774.     XEvent *eventPtr;        /* Information about event. */
  775. {
  776.     int *donePtr = (int *) clientData;
  777.  
  778.     if (eventPtr->type == DestroyNotify) {
  779.     *donePtr = 1;
  780.     }
  781. }
  782.  
  783. /*
  784.  *----------------------------------------------------------------------
  785.  *
  786.  * Tk_UpdateCmd --
  787.  *
  788.  *    This procedure is invoked to process the "update" Tcl command.
  789.  *    See the user documentation for details on what it does.
  790.  *
  791.  * Results:
  792.  *    A standard Tcl result.
  793.  *
  794.  * Side effects:
  795.  *    See the user documentation.
  796.  *
  797.  *----------------------------------------------------------------------
  798.  */
  799.  
  800.     /* ARGSUSED */
  801. int
  802. Tk_UpdateCmd(clientData, interp, argc, argv)
  803.     ClientData clientData;    /* Main window associated with
  804.                  * interpreter. */
  805.     Tcl_Interp *interp;        /* Current interpreter. */
  806.     int argc;            /* Number of arguments. */
  807.     char **argv;        /* Argument strings. */
  808. {
  809.     Tk_Window tkwin = (Tk_Window) clientData;
  810.     int flags;
  811.     Display *display;
  812.  
  813.     if (argc == 1) {
  814.     flags = TCL_DONT_WAIT;
  815.     } else if (argc == 2) {
  816.     if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
  817.         Tcl_AppendResult(interp, "bad option \"", argv[1],
  818.             "\": must be idletasks", (char *) NULL);
  819.         return TCL_ERROR;
  820.     }
  821.     flags = TCL_IDLE_EVENTS;
  822.     } else {
  823.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  824.         argv[0], " ?idletasks?\"", (char *) NULL);
  825.     return TCL_ERROR;
  826.     }
  827.  
  828.     /*
  829.      * Handle all pending events, sync the display, and repeat over
  830.      * and over again until all pending events have been handled.
  831.      * Special note:  it's possible that the entire application could
  832.      * be destroyed by an event handler that occurs during the update.
  833.      * Thus, don't use any information from tkwin after calling
  834.      * Tcl_DoOneEvent.
  835.      */
  836.  
  837.     display = Tk_Display(tkwin);
  838.     while (1) {
  839.     while (Tcl_DoOneEvent(flags) != 0) {
  840.         /* Empty loop body */
  841.     }
  842.     XSync(display, False);
  843.     if (Tcl_DoOneEvent(flags) == 0) {
  844.         break;
  845.     }
  846.     }
  847.  
  848.     /*
  849.      * Must clear the interpreter's result because event handlers could
  850.      * have executed commands.
  851.      */
  852.  
  853.     Tcl_ResetResult(interp);
  854.     return TCL_OK;
  855. }
  856.  
  857. /*
  858.  *----------------------------------------------------------------------
  859.  *
  860.  * Tk_WinfoCmd --
  861.  *
  862.  *    This procedure is invoked to process the "winfo" Tcl command.
  863.  *    See the user documentation for details on what it does.
  864.  *
  865.  * Results:
  866.  *    A standard Tcl result.
  867.  *
  868.  * Side effects:
  869.  *    See the user documentation.
  870.  *
  871.  *----------------------------------------------------------------------
  872.  */
  873.  
  874. int
  875. Tk_WinfoCmd(clientData, interp, argc, argv)
  876.     ClientData clientData;    /* Main window associated with
  877.                  * interpreter. */
  878.     Tcl_Interp *interp;        /* Current interpreter. */
  879.     int argc;            /* Number of arguments. */
  880.     char **argv;        /* Argument strings. */
  881. {
  882.     Tk_Window tkwin = (Tk_Window) clientData;
  883.     size_t length;
  884.     char c, *argName;
  885.     Tk_Window window;
  886.     register TkWindow *winPtr;
  887.  
  888. #define SETUP(name) \
  889.     if (argc != 3) {\
  890.     argName = name; \
  891.     goto wrongArgs; \
  892.     } \
  893.     window = Tk_NameToWindow(interp, argv[2], tkwin); \
  894.     if (window == NULL) { \
  895.     return TCL_ERROR; \
  896.     }
  897.  
  898.     if (argc < 2) {
  899.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  900.         argv[0], " option ?arg?\"", (char *) NULL);
  901.     return TCL_ERROR;
  902.     }
  903.     c = argv[1][0];
  904.     length = strlen(argv[1]);
  905.     if ((c == 'a') && (strcmp(argv[1], "atom") == 0)) {
  906.     char *atomName;
  907.  
  908.     if (argc == 3) {
  909.         atomName = argv[2];
  910.     } else if (argc == 5) {
  911.         atomName = argv[4];
  912.         tkwin = GetDisplayOf(interp, tkwin, argv+2);
  913.         if (tkwin == NULL) {
  914.         return TCL_ERROR;
  915.         }
  916.     } else {
  917.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  918.             argv[0], " atom ?-displayof window? name\"",
  919.             (char *) NULL);
  920.         return TCL_ERROR;
  921.     }
  922.     sprintf(interp->result, "%ld", Tk_InternAtom(tkwin, atomName));
  923.     } else if ((c == 'a') && (strncmp(argv[1], "atomname", length) == 0)
  924.         && (length >= 5)) {
  925.     Atom atom;
  926.     char *name, *id;
  927.  
  928.     if (argc == 3) {
  929.         id = argv[2];
  930.     } else if (argc == 5) {
  931.         id = argv[4];
  932.         tkwin = GetDisplayOf(interp, tkwin, argv+2);
  933.         if (tkwin == NULL) {
  934.         return TCL_ERROR;
  935.         }
  936.     } else {
  937.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  938.             argv[0], " atomname ?-displayof window? id\"",
  939.             (char *) NULL);
  940.         return TCL_ERROR;
  941.     }
  942.     if (Tcl_GetInt(interp, id, (int *) &atom) != TCL_OK) {
  943.         return TCL_ERROR;
  944.     }
  945.     name = Tk_GetAtomName(tkwin, atom);
  946.     if (strcmp(name, "?bad atom?") == 0) {
  947.         Tcl_AppendResult(interp, "no atom exists with id \"",
  948.             argv[2], "\"", (char *) NULL);
  949.         return TCL_ERROR;
  950.     }
  951. #ifdef STk_CODE
  952.     STk_stringify_result(interp, name);
  953. #else
  954.     interp->result = name;
  955. #endif
  956.     } else if ((c == 'c') && (strncmp(argv[1], "cells", length) == 0)
  957.         && (length >= 2)) {
  958.     SETUP("cells");
  959.     sprintf(interp->result, "%d", Tk_Visual(window)->map_entries);
  960.     } else if ((c == 'c') && (strncmp(argv[1], "children", length) == 0)
  961.         && (length >= 2)) {
  962.     SETUP("children");
  963. #ifdef STk_CODE
  964.     Tcl_AppendElement(interp, "#.(list ");
  965. #endif
  966.     for (winPtr = ((TkWindow *) window)->childList; winPtr != NULL;
  967.         winPtr = winPtr->nextPtr) {
  968.         Tcl_AppendElement(interp, winPtr->pathName);
  969.     }
  970. #ifdef STk_CODE
  971.     Tcl_AppendElement(interp, ")");
  972. #endif
  973.     } else if ((c == 'c') && (strncmp(argv[1], "class", length) == 0)
  974.         && (length >= 2)) {
  975.     SETUP("class");
  976. #ifdef STk_CODE
  977.     STk_stringify_result(interp, Tk_Class(window));
  978. #else
  979.     interp->result = Tk_Class(window);
  980. #endif
  981.     } else if ((c == 'c') && (strncmp(argv[1], "colormapfull", length) == 0)
  982.         && (length >= 3)) {
  983.     SETUP("colormapfull");
  984.     interp->result = (TkCmapStressed(window, Tk_Colormap(window)))
  985. #ifdef STk_CODE
  986.         ? "#t" : "#f";
  987. #else
  988.         ? "1" : "0";
  989. #endif
  990.     } else if ((c == 'c') && (strncmp(argv[1], "containing", length) == 0)
  991.         && (length >= 3)) {
  992.     int rootX, rootY, index;
  993.  
  994.     if (argc == 4) {
  995.         index = 2;
  996.     } else if (argc == 6) {
  997.         index = 4;
  998.         tkwin = GetDisplayOf(interp, tkwin, argv+2);
  999.         if (tkwin == NULL) {
  1000.         return TCL_ERROR;
  1001.         }
  1002.     } else {
  1003.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1004.             argv[0], " containing ?-displayof window? rootX rootY\"",
  1005.             (char *) NULL);
  1006.         return TCL_ERROR;
  1007.     }
  1008.     if ((Tk_GetPixels(interp, tkwin, argv[index], &rootX) != TCL_OK)
  1009.         || (Tk_GetPixels(interp, tkwin, argv[index+1], &rootY)
  1010.         != TCL_OK)) {
  1011.         return TCL_ERROR;
  1012.     }
  1013.     window = Tk_CoordsToWindow(rootX, rootY, tkwin);
  1014.     if (window != NULL) {
  1015. #ifdef STk_CODE
  1016.         STk_sharp_dot_result(interp, Tk_PathName(window));
  1017.     }
  1018.     else {
  1019.       interp->result = "#f";
  1020. #else
  1021.         interp->result = Tk_PathName(window);
  1022. #endif
  1023.     }
  1024.     } else if ((c == 'd') && (strncmp(argv[1], "depth", length) == 0)) {
  1025.     SETUP("depth");
  1026.     sprintf(interp->result, "%d", Tk_Depth(window));
  1027.     } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)) {
  1028.     if (argc != 3) {
  1029.         argName = "exists";
  1030.         goto wrongArgs;
  1031.     }
  1032.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  1033.     if ((window == NULL)
  1034.         || (((TkWindow *) window)->flags & TK_ALREADY_DEAD)) {
  1035. #ifdef STk_CODE
  1036.         interp->result = "#f";
  1037. #else
  1038.         interp->result = "0";
  1039. #endif
  1040.     } else {
  1041. #ifdef STk_CODE
  1042.         interp->result = "#t";
  1043. #else
  1044.         interp->result = "1";
  1045. #endif
  1046.     }
  1047.     } else if ((c == 'f') && (strncmp(argv[1], "fpixels", length) == 0)
  1048.         && (length >= 2)) {
  1049.     double mm, pixels;
  1050.  
  1051.     if (argc != 4) {
  1052.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1053.             argv[0], " fpixels window number\"", (char *) NULL);
  1054.         return TCL_ERROR;
  1055.     }
  1056.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  1057.     if (window == NULL) {
  1058.         return TCL_ERROR;
  1059.     }
  1060.     if (Tk_GetScreenMM(interp, window, argv[3], &mm) != TCL_OK) {
  1061.         return TCL_ERROR;
  1062.     }
  1063.     pixels = mm * WidthOfScreen(Tk_Screen(window))
  1064.         / WidthMMOfScreen(Tk_Screen(window));
  1065.     Tcl_PrintDouble(interp, pixels, interp->result);
  1066.     } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) {
  1067.     SETUP("geometry");
  1068.     sprintf(interp->result, "%dx%d+%d+%d", Tk_Width(window),
  1069.         Tk_Height(window), Tk_X(window), Tk_Y(window));
  1070.     } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
  1071.     SETUP("height");
  1072.     sprintf(interp->result, "%d", Tk_Height(window));
  1073.     } else if ((c == 'i') && (strcmp(argv[1], "id") == 0)) {
  1074.     SETUP("id");
  1075.     Tk_MakeWindowExist(window);
  1076. #ifdef STk_CODE
  1077.     sprintf(interp->result, "#x%x", (unsigned int) Tk_WindowId(window));
  1078. #else
  1079.     sprintf(interp->result, "0x%x", (unsigned int) Tk_WindowId(window));
  1080. #endif
  1081.     } else if ((c == 'i') && (strncmp(argv[1], "interps", length) == 0)
  1082.         && (length >= 2)) {
  1083.     if (argc == 4) {
  1084.         tkwin = GetDisplayOf(interp, tkwin, argv+2);
  1085.         if (tkwin == NULL) {
  1086.         return TCL_ERROR;
  1087.         }
  1088.     } else if (argc != 2) {
  1089.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1090.             argv[0], " interps ?-displayof window?\"",
  1091.             (char *) NULL);
  1092.         return TCL_ERROR;
  1093.     }
  1094.     return TkGetInterpNames(interp, tkwin);
  1095.     } else if ((c == 'i') && (strncmp(argv[1], "ismapped", length) == 0)
  1096.         && (length >= 2)) {
  1097.     SETUP("ismapped");
  1098. #ifdef STk_CODE
  1099.     interp->result = Tk_IsMapped(window) ? "#t" : "#f";
  1100. #else
  1101.     interp->result = Tk_IsMapped(window) ? "1" : "0";
  1102. #endif
  1103.     } else if ((c == 'm') && (strncmp(argv[1], "manager", length) == 0)) {
  1104.     SETUP("manager");
  1105.     winPtr = (TkWindow *) window;
  1106.     if (winPtr->geomMgrPtr != NULL) {
  1107. #ifdef STk_CODE
  1108.         STk_stringify_result(interp, winPtr->geomMgrPtr->name);
  1109.     }
  1110.     else
  1111.       interp->result = "#f";
  1112. #else
  1113.         interp->result = winPtr->geomMgrPtr->name;
  1114.     }
  1115. #endif
  1116.     } else if ((c == 'n') && (strncmp(argv[1], "name", length) == 0)) {
  1117.     SETUP("name");
  1118. #ifdef STk_CODE
  1119.     STk_stringify_result(interp, Tk_Name(window));
  1120. #else
  1121.     interp->result = Tk_Name(window);
  1122. #endif
  1123.     } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0)) {
  1124.     SETUP("parent");
  1125.     winPtr = (TkWindow *) window;
  1126.     if (winPtr->parentPtr != NULL) {
  1127. #ifdef STk_CODE
  1128.         STk_sharp_dot_result(interp, winPtr->parentPtr->pathName);
  1129. #else
  1130.         interp->result = winPtr->parentPtr->pathName;
  1131. #endif
  1132.     }
  1133.     } else if ((c == 'p') && (strncmp(argv[1], "pathname", length) == 0)
  1134.         && (length >= 2)) {
  1135.     int index, id;
  1136.  
  1137.     if (argc == 3) {
  1138.         index = 2;
  1139.     } else if (argc == 5) {
  1140.         index = 4;
  1141.         tkwin = GetDisplayOf(interp, tkwin, argv+2);
  1142.         if (tkwin == NULL) {
  1143.         return TCL_ERROR;
  1144.         }
  1145.     } else {
  1146.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1147.             argv[0], " pathname ?-displayof window? id\"",
  1148.             (char *) NULL);
  1149.         return TCL_ERROR;
  1150.     }
  1151.     if (Tcl_GetInt(interp, argv[index], &id) != TCL_OK) {
  1152.         return TCL_ERROR;
  1153.     }
  1154.     window = Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
  1155.     if ((window == NULL) || (((TkWindow *) window)->mainPtr
  1156.         != ((TkWindow *) tkwin)->mainPtr)) {
  1157.         Tcl_AppendResult(interp, "window id \"", argv[index],
  1158.             "\" doesn't exist in this application", (char *) NULL);
  1159.         return TCL_ERROR;
  1160.     }
  1161. #ifdef STk_CODE
  1162.     STk_stringify_result(interp, Tk_PathName(window));
  1163. #else
  1164.     interp->result = Tk_PathName(window);
  1165. #endif
  1166.     } else if ((c == 'p') && (strncmp(argv[1], "pixels", length) == 0)
  1167.         && (length >= 2)) {
  1168.     int pixels;
  1169.  
  1170.     if (argc != 4) {
  1171.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1172.             argv[0], " pixels window number\"", (char *) NULL);
  1173.         return TCL_ERROR;
  1174.     }
  1175.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  1176.     if (window == NULL) {
  1177.         return TCL_ERROR;
  1178.     }
  1179.     if (Tk_GetPixels(interp, window, argv[3], &pixels) != TCL_OK) {
  1180.         return TCL_ERROR;
  1181.     }
  1182.     sprintf(interp->result, "%d", pixels);
  1183.     } else if ((c == 'p') && (strcmp(argv[1], "pointerx") == 0)) {
  1184.     int x, y;
  1185.  
  1186.     SETUP("pointerx");
  1187.     winPtr = GetToplevel(window);
  1188.     if (winPtr == NULL) {
  1189.         x = -1;
  1190.     } else {
  1191.         TkGetPointerCoords((Tk_Window)winPtr, &x, &y);
  1192.     }
  1193.     sprintf(interp->result, "%d", x);
  1194.     } else if ((c == 'p') && (strcmp(argv[1], "pointerxy") == 0)) {
  1195.     int x, y;
  1196.  
  1197.     SETUP("pointerxy");
  1198.     winPtr = GetToplevel(window);
  1199.     if (winPtr == NULL) {
  1200.         x = -1;
  1201.     } else {
  1202.         TkGetPointerCoords((Tk_Window)winPtr, &x, &y);
  1203.     }
  1204.     sprintf(interp->result, "%d %d", x, y);
  1205.     } else if ((c == 'p') && (strcmp(argv[1], "pointery") == 0)) {
  1206.     int x, y;
  1207.  
  1208.     SETUP("pointery");
  1209.     winPtr = GetToplevel(window);
  1210.     if (winPtr == NULL) {
  1211.         y = -1;
  1212.     } else {
  1213.         TkGetPointerCoords((Tk_Window)winPtr, &x, &y);
  1214.     }
  1215.     sprintf(interp->result, "%d", y);
  1216.     } else if ((c == 'r') && (strncmp(argv[1], "reqheight", length) == 0)
  1217.         && (length >= 4)) {
  1218.     SETUP("reqheight");
  1219.     sprintf(interp->result, "%d", Tk_ReqHeight(window));
  1220.     } else if ((c == 'r') && (strncmp(argv[1], "reqwidth", length) == 0)
  1221.         && (length >= 4)) {
  1222.     SETUP("reqwidth");
  1223.     sprintf(interp->result, "%d", Tk_ReqWidth(window));
  1224.     } else if ((c == 'r') && (strncmp(argv[1], "rgb", length) == 0)
  1225.         && (length >= 2)) {
  1226.     XColor *colorPtr;
  1227.  
  1228.     if (argc != 4) {
  1229.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1230.             argv[0], " rgb window colorName\"", (char *) NULL);
  1231.         return TCL_ERROR;
  1232.     }
  1233.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  1234.     if (window == NULL) {
  1235.         return TCL_ERROR;
  1236.     }
  1237.     colorPtr = Tk_GetColor(interp, window, argv[3]);
  1238.     if (colorPtr == NULL) {
  1239.         return TCL_ERROR;
  1240.     }
  1241.     sprintf(interp->result, "%d %d %d", colorPtr->red, colorPtr->green,
  1242.         colorPtr->blue);
  1243.     Tk_FreeColor(colorPtr);
  1244.     } else if ((c == 'r') && (strcmp(argv[1], "rootx") == 0)) {
  1245.     int x, y;
  1246.  
  1247.     SETUP("rootx");
  1248.     Tk_GetRootCoords(window, &x, &y);
  1249.     sprintf(interp->result, "%d", x);
  1250.     } else if ((c == 'r') && (strcmp(argv[1], "rooty") == 0)) {
  1251.     int x, y;
  1252.  
  1253.     SETUP("rooty");
  1254.     Tk_GetRootCoords(window, &x, &y);
  1255.     sprintf(interp->result, "%d", y);
  1256.     } else if ((c == 's') && (strcmp(argv[1], "screen") == 0)) {
  1257.     char string[20];
  1258.  
  1259.     SETUP("screen");
  1260.     sprintf(string, "%d", Tk_ScreenNumber(window));
  1261.     Tcl_AppendResult(interp, Tk_DisplayName(window), ".", string,
  1262.         (char *) NULL);
  1263. #ifdef STk_CODE
  1264.     STk_stringify_result(interp, interp->result);
  1265. #endif
  1266.     } else if ((c == 's') && (strncmp(argv[1], "screencells", length) == 0)
  1267.         && (length >= 7)) {
  1268.     SETUP("screencells");
  1269.     sprintf(interp->result, "%d", CellsOfScreen(Tk_Screen(window)));
  1270.     } else if ((c == 's') && (strncmp(argv[1], "screendepth", length) == 0)
  1271.         && (length >= 7)) {
  1272.     SETUP("screendepth");
  1273.     sprintf(interp->result, "%d", DefaultDepthOfScreen(Tk_Screen(window)));
  1274.     } else if ((c == 's') && (strncmp(argv[1], "screenheight", length) == 0)
  1275.         && (length >= 7)) {
  1276.     SETUP("screenheight");
  1277.     sprintf(interp->result, "%d",  HeightOfScreen(Tk_Screen(window)));
  1278.     } else if ((c == 's') && (strncmp(argv[1], "screenmmheight", length) == 0)
  1279.         && (length >= 9)) {
  1280.     SETUP("screenmmheight");
  1281.     sprintf(interp->result, "%d",  HeightMMOfScreen(Tk_Screen(window)));
  1282.     } else if ((c == 's') && (strncmp(argv[1], "screenmmwidth", length) == 0)
  1283.         && (length >= 9)) {
  1284.     SETUP("screenmmwidth");
  1285.     sprintf(interp->result, "%d",  WidthMMOfScreen(Tk_Screen(window)));
  1286.     } else if ((c == 's') && (strncmp(argv[1], "screenvisual", length) == 0)
  1287.         && (length >= 7)) {
  1288.     SETUP("screenvisual");
  1289.     switch (DefaultVisualOfScreen(Tk_Screen(window))->class) {
  1290.         case PseudoColor:    interp->result = "pseudocolor"; break;
  1291.         case GrayScale:    interp->result = "grayscale"; break;
  1292.         case DirectColor:    interp->result = "directcolor"; break;
  1293.         case TrueColor:    interp->result = "truecolor"; break;
  1294.         case StaticColor:    interp->result = "staticcolor"; break;
  1295.         case StaticGray:    interp->result = "staticgray"; break;
  1296.         default:        interp->result = "unknown"; break;
  1297.     }
  1298.     } else if ((c == 's') && (strncmp(argv[1], "screenwidth", length) == 0)
  1299.         && (length >= 7)) {
  1300.     SETUP("screenwidth");
  1301.     sprintf(interp->result, "%d",  WidthOfScreen(Tk_Screen(window)));
  1302.     } else if ((c == 's') && (strncmp(argv[1], "server", length) == 0)
  1303.         && (length >= 2)) {
  1304.     SETUP("server");
  1305.     TkGetServerInfo(interp, window);
  1306. #ifdef STk_CODE
  1307.     { 
  1308.       char *s = (char*) STk_stringify(interp->result, 0);
  1309.       Tcl_SetResult(interp, s, TCL_VOLATILE);
  1310.     }    
  1311. #endif
  1312.     } else if ((c == 't') && (strncmp(argv[1], "toplevel", length) == 0)) {
  1313.     SETUP("toplevel");
  1314.     winPtr = GetToplevel(window);
  1315.     if (winPtr != NULL) {
  1316. #ifdef STk_CODE
  1317.         STk_sharp_dot_result(interp, winPtr->pathName);
  1318. #else
  1319.         interp->result = winPtr->pathName;
  1320. #endif
  1321.     }
  1322.     } else if ((c == 'v') && (strncmp(argv[1], "viewable", length) == 0)
  1323.         && (length >= 3)) {
  1324.     SETUP("viewable");
  1325.     for (winPtr = (TkWindow *) window; ; winPtr = winPtr->parentPtr) {
  1326.         if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
  1327. #ifdef STk_CODE
  1328.         interp->result = "#f";
  1329. #else
  1330.         interp->result = "0";
  1331. #endif
  1332.         break;
  1333.         }
  1334.         if (winPtr->flags & TK_TOP_LEVEL) {
  1335. #ifdef STk_CODE
  1336.         interp->result = "#t";
  1337. #else
  1338.         interp->result = "1";
  1339. #endif
  1340.         break;
  1341.         }
  1342.     }
  1343.     } else if ((c == 'v') && (strcmp(argv[1], "visual") == 0)) {
  1344.     SETUP("visual");
  1345.     switch (Tk_Visual(window)->class) {
  1346.         case PseudoColor:    interp->result = "pseudocolor"; break;
  1347.         case GrayScale:    interp->result = "grayscale"; break;
  1348.         case DirectColor:    interp->result = "directcolor"; break;
  1349.         case TrueColor:    interp->result = "truecolor"; break;
  1350.         case StaticColor:    interp->result = "staticcolor"; break;
  1351.         case StaticGray:    interp->result = "staticgray"; break;
  1352.         default:        interp->result = "unknown"; break;
  1353.     }
  1354.     } else if ((c == 'v') && (strncmp(argv[1], "visualid", length) == 0)
  1355.            && (length >= 7)) {
  1356.     SETUP("visualid");
  1357.     sprintf(interp->result, "0x%x", (unsigned int)
  1358.         XVisualIDFromVisual(Tk_Visual(window)));
  1359.     } else if ((c == 'v') && (strncmp(argv[1], "visualsavailable", length) == 0)
  1360.         && (length >= 7)) {
  1361.     XVisualInfo template, *visInfoPtr;
  1362.     int count, i;
  1363.     char string[70], visualIdString[16], *fmt;
  1364.     int includeVisualId;
  1365.  
  1366.     if (argc == 3) {
  1367.         includeVisualId = 0;
  1368.     } else if ((argc == 4)
  1369.         && (strncmp(argv[3], "includeids", strlen(argv[3])) == 0)) {
  1370.         includeVisualId = 1;
  1371.     } else {
  1372.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1373.             argv[0], " visualsavailable window ?includeids?\"", 
  1374.             (char *) NULL);
  1375.         return TCL_ERROR;
  1376.     }
  1377.  
  1378.     window = Tk_NameToWindow(interp, argv[2], tkwin); 
  1379.     if (window == NULL) { 
  1380.       return TCL_ERROR; 
  1381.     }
  1382.  
  1383.     template.screen = Tk_ScreenNumber(window);
  1384.     visInfoPtr = XGetVisualInfo(Tk_Display(window), VisualScreenMask,
  1385.         &template, &count);
  1386.     if (visInfoPtr == NULL) {
  1387.         interp->result = "can't find any visuals for screen";
  1388.         return TCL_ERROR;
  1389.     }
  1390.     for (i = 0; i < count; i++) {
  1391.         switch (visInfoPtr[i].class) {
  1392.         case PseudoColor:    fmt = "pseudocolor %d"; break;
  1393.         case GrayScale:        fmt = "grayscale %d"; break;
  1394.         case DirectColor:    fmt = "directcolor %d"; break;
  1395.         case TrueColor:        fmt = "truecolor %d"; break;
  1396.         case StaticColor:    fmt = "staticcolor %d"; break;
  1397.         case StaticGray:    fmt = "staticgray %d"; break;
  1398.         default:        fmt = "unknown"; break;
  1399.         }
  1400.         sprintf(string, fmt, visInfoPtr[i].depth);
  1401.         if (includeVisualId) {
  1402.         sprintf(visualIdString, " 0x%x",
  1403.             (unsigned int) visInfoPtr[i].visualid);
  1404.         strcat(string, visualIdString);
  1405.         }
  1406.         Tcl_AppendElement(interp, string);
  1407.     }
  1408.     XFree((char *) visInfoPtr);
  1409.     } else if ((c == 'v') && (strncmp(argv[1], "vrootheight", length) == 0)
  1410.         && (length >= 6)) {
  1411.     int x, y;
  1412.     int width, height;
  1413.  
  1414.     SETUP("vrootheight");
  1415.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1416.     sprintf(interp->result, "%d", height);
  1417.     } else if ((c == 'v') && (strncmp(argv[1], "vrootwidth", length) == 0)
  1418.         && (length >= 6)) {
  1419.     int x, y;
  1420.     int width, height;
  1421.  
  1422.     SETUP("vrootwidth");
  1423.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1424.     sprintf(interp->result, "%d", width);
  1425.     } else if ((c == 'v') && (strcmp(argv[1], "vrootx") == 0)) {
  1426.     int x, y;
  1427.     int width, height;
  1428.  
  1429.     SETUP("vrootx");
  1430.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1431.     sprintf(interp->result, "%d", x);
  1432.     } else if ((c == 'v') && (strcmp(argv[1], "vrooty") == 0)) {
  1433.     int x, y;
  1434.     int width, height;
  1435.  
  1436.     SETUP("vrooty");
  1437.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1438.     sprintf(interp->result, "%d", y);
  1439.     } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
  1440.     SETUP("width");
  1441.     sprintf(interp->result, "%d", Tk_Width(window));
  1442.     } else if ((c == 'x') && (argv[1][1] == '\0')) {
  1443.     SETUP("x");
  1444.     sprintf(interp->result, "%d", Tk_X(window));
  1445.     } else if ((c == 'y') && (argv[1][1] == '\0')) {
  1446.     SETUP("y");
  1447.     sprintf(interp->result, "%d", Tk_Y(window));
  1448.     } else {
  1449.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  1450.         "\": must be atom, atomname, cells, children, ",
  1451.         "class, colormapfull, containing, depth, exists, fpixels, ",
  1452.         "geometry, height, ",
  1453.         "id, interps, ismapped, manager, name, parent, pathname, ",
  1454.         "pixels, pointerx, pointerxy, pointery, reqheight, ",
  1455.         "reqwidth, rgb, ",
  1456.         "rootx, rooty, ",
  1457.         "screen, screencells, screendepth, screenheight, ",
  1458.         "screenmmheight, screenmmwidth, screenvisual, ",
  1459.         "screenwidth, server, ",
  1460.         "toplevel, viewable, visual, visualid, visualsavailable, ",
  1461.         "vrootheight, vrootwidth, vrootx, vrooty, ",
  1462.         "width, x, or y", (char *) NULL);
  1463.     return TCL_ERROR;
  1464.     }
  1465.     return TCL_OK;
  1466.  
  1467.     wrongArgs:
  1468.     Tcl_AppendResult(interp, "wrong # arguments: must be \"",
  1469.         argv[0], " ", argName, " window\"", (char *) NULL);
  1470.     return TCL_ERROR;
  1471. }
  1472.  
  1473. /*
  1474.  *----------------------------------------------------------------------
  1475.  *
  1476.  * GetDisplayOf --
  1477.  *
  1478.  *    Parses a "-displayof" option for the "winfo" command.
  1479.  *
  1480.  * Results:
  1481.  *    The return value is a token for the window specified in
  1482.  *    argv[1].  If argv[0] and argv[1] couldn't be parsed, NULL
  1483.  *    is returned and an error is left in interp->result.
  1484.  *
  1485.  * Side effects:
  1486.  *    None.
  1487.  *
  1488.  *----------------------------------------------------------------------
  1489.  */
  1490.  
  1491. static Tk_Window
  1492. GetDisplayOf(interp, tkwin, argv)
  1493.     Tcl_Interp *interp;        /* Interpreter for error reporting. */
  1494.     Tk_Window tkwin;        /* Window to use for looking up window
  1495.                  * given in argv[1]. */
  1496.     char **argv;        /* Array of two strings.   First must be
  1497.                  * "-displayof" or an abbreviation, second
  1498.                  * must be window name. */
  1499. {
  1500.     size_t length;
  1501.  
  1502.     length = strlen(argv[0]);
  1503.     if ((length < 2) || (strncmp(argv[0], "-displayof", length) != 0)) {
  1504.     Tcl_AppendResult(interp, "bad argument \"", argv[0],
  1505.         "\": must be -displayof", (char *) NULL);
  1506.     return (Tk_Window) NULL;
  1507.     }
  1508.     return Tk_NameToWindow(interp, argv[1], tkwin);
  1509. }
  1510.  
  1511. /*
  1512.  *----------------------------------------------------------------------
  1513.  *
  1514.  * TkDeadAppCmd --
  1515.  *
  1516.  *    If an application has been deleted then all Tk commands will be
  1517.  *    re-bound to this procedure.
  1518.  *
  1519.  * Results:
  1520.  *    A standard Tcl error is reported to let the user know that
  1521.  *    the application is dead.
  1522.  *
  1523.  * Side effects:
  1524.  *    See the user documentation.
  1525.  *
  1526.  *----------------------------------------------------------------------
  1527.  */
  1528.  
  1529.     /* ARGSUSED */
  1530. int
  1531. TkDeadAppCmd(clientData, interp, argc, argv)
  1532.     ClientData clientData;    /* Dummy. */
  1533.     Tcl_Interp *interp;        /* Current interpreter. */
  1534.     int argc;            /* Number of arguments. */
  1535.     char **argv;        /* Argument strings. */
  1536. {
  1537.     Tcl_AppendResult(interp, "can't invoke \"", argv[0],
  1538.         "\" command:  application has been destroyed", (char *) NULL);
  1539.     return TCL_ERROR;
  1540. }
  1541.  
  1542. /*
  1543.  *----------------------------------------------------------------------
  1544.  *
  1545.  * GetToplevel --
  1546.  *
  1547.  *    Retrieves the toplevel window which is the nearest ancestor of
  1548.  *    of the specified window.
  1549.  *
  1550.  * Results:
  1551.  *    Returns the toplevel window or NULL if the window has no
  1552.  *    ancestor which is a toplevel.
  1553.  *
  1554.  * Side effects:
  1555.  *    None.
  1556.  *
  1557.  *----------------------------------------------------------------------
  1558.  */
  1559.  
  1560. static TkWindow *
  1561. GetToplevel(tkwin)
  1562.     Tk_Window tkwin;        /* Window for which the toplevel should be
  1563.                  * deterined. */
  1564. {
  1565.      TkWindow *winPtr = (TkWindow *) tkwin;
  1566.  
  1567.      while (!(winPtr->flags & TK_TOP_LEVEL)) {
  1568.      winPtr = winPtr->parentPtr;
  1569.      if (winPtr == NULL) {
  1570.          return NULL;
  1571.      }
  1572.      }
  1573.      return winPtr;
  1574. }
  1575.